home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / ilisp / ilisp-hnd.el.z / ilisp-hnd.el
Encoding:
Text File  |  1998-05-21  |  3.1 KB  |  108 lines
  1. ;;; -*- Mode: Emacs-Lisp -*-
  2.  
  3. ;;; ilisp-hnd.el --
  4.  
  5. ;;; This file is part of ILISP.
  6. ;;; Version: 5.8
  7. ;;;
  8. ;;; Copyright (C) 1990, 1991, 1992, 1993 Chris McConnell
  9. ;;;               1993, 1994 Ivan Vasquez
  10. ;;;               1994, 1995, 1996 Marco Antoniotti and Rick Busdiecker
  11. ;;;               1996 Marco Antoniotti and Rick Campbell
  12. ;;;
  13. ;;; Other authors' names for which this Copyright notice also holds
  14. ;;; may appear later in this file.
  15. ;;;
  16. ;;; Send mail to 'ilisp-request@naggum.no' to be included in the
  17. ;;; ILISP mailing list. 'ilisp@naggum.no' is the general ILISP
  18. ;;; mailing list were bugs and improvements are discussed.
  19. ;;;
  20. ;;; ILISP is freely redistributable under the terms found in the file
  21. ;;; COPYING.
  22.  
  23.  
  24. ;;;
  25. ;;; ILISP Error handler
  26. ;;;
  27.  
  28.  
  29. ;; Do not handle errors by default.
  30. (defvar ilisp-handle-errors nil)
  31.  
  32. ;;;
  33. (defun ilisp-handler (error-p wait-p message output prompt)
  34.   "Given ERROR-P, WAIT-P, MESSAGE, OUTPUT and PROMPT, show the message
  35. and output if there is an error or the output is multiple lines and
  36. let the user decide what to do."
  37.   (if (not ilisp-handle-errors)
  38.       (progn
  39.     (if message
  40.         (progn
  41.           (setq ilisp-last-message message
  42.             ilisp-last-prompt prompt)
  43.           (if (not wait-p) (lisp-display-output output))))
  44.     nil)
  45.     (if (and (not wait-p)
  46.          (setq output (comint-remove-whitespace output))
  47.          (or error-p (string-match "\n" output)))
  48.     (let* ((buffer (ilisp-output-buffer))
  49.            (out (if error-p 
  50.             (funcall ilisp-error-filter output)
  51.               output))
  52.            (key
  53.         (if (and error-p (not (comint-interrupted)))
  54.             (comint-handle-error
  55.              out
  56.      "SPC-scroll, I-ignore, K-keep, A-abort sends and keep or B-break: "
  57.              '(?i ?k ?a ?b))
  58.           (comint-handle-error 
  59.            out 
  60.        "SPC-scroll, I-ignore, K-keep or A-abort sends and keep: "
  61.            '(?i ?k ?a))))
  62.            (clear comint-queue-emptied))
  63.       (if (= key ?i)
  64.           (progn
  65.         (message "Ignore message")
  66.         (if buffer 
  67.             (funcall
  68.              (ilisp-temp-buffer-show-function)
  69.              buffer)
  70.           (ilisp-bury-output))
  71.         t)
  72.         (save-excursion
  73.           (set-buffer (get-buffer-create "*Errors*"))
  74.           (if clear (delete-region (point-min) (point-max)))
  75.           (goto-char (point-max))
  76.           (insert message)
  77.           (insert ?\n)
  78.           (insert out) 
  79.           (insert "\n\n"))
  80.         (if clear (setq comint-queue-emptied nil))
  81.         (if (= key ?a)
  82.         (progn 
  83.           (message "Abort pending commands and keep in *Errors*")
  84.           (comint-abort-sends)
  85.           t)
  86.           (if (= key ?b)
  87.           (progn 
  88.             (comint-insert
  89.              (concat comment-start comment-start comment-start
  90.                  message "\n"
  91.                  output "\n" prompt))
  92.             (message "Preserve break") nil)
  93.         (message "Keep error in *Errors* and continue")
  94.         t))))
  95.       t)))
  96.  
  97. ;;;
  98. (defun ilisp-abort-handler ()
  99.   "Handle when the user aborts commands."
  100.   (setq ilisp-initializing nil
  101.     ilisp-load-files nil)
  102.   (let ((add nil))
  103.     (while ilisp-pending-changes
  104.       (if (not (memq (car ilisp-pending-changes) lisp-changes))
  105.       (setq add (cons (car ilisp-pending-changes) add)))
  106.       (setq ilisp-pending-changes (cdr ilisp-pending-changes)))
  107.     (setq lisp-changes (nconc lisp-changes add))))
  108.